# pacotes utilizados
require(keras)
require(dplyr)
require(magrittr)
require(ggplot2)
require(plotly)
require(glue)
require(tfdeploy)
# carregando workspace
load("text_classification.RData")
O exemplo desenvolvido aqui foi extraído desta postagem do TensorFlow for R Blog.
Neste exemplo, trabalharemos com o conjunto de dados do IMDB: um conjunto de 50.000 avaliações altamente polarizadas do Internet Movie Database. Eles são divididos em 25.000 avaliações para treinamento e 25.000 avaliações para testes, cada conjunto consistindo em 50% de avaliações negativas e 50% positivas.
Para análise só foram consideradas as 10000 mais frequentes palavras. O objetivo desta análise é a classificação de um review em positivo ou negativo.
Foi utilizado modelos de Deep Learning para classificação. O modelo utiliza a biblioteca keras, que em seu back-end roda em TensorFlow.
O modelo utilizado é um Multi-Layer Perceptron como apresentado abaixo:
DiagrammeR::grViz("mlp.gv")
Estrutura da rede
A função de ativação nas camadas ocultas foram a relu e na classificação foi a sigmoid.
relu <- function(x) ifelse(x <= 0, 0, x)
ggplotly(tibble(x = seq(-2, 1.5, .1)) %>%
ggplot() +
aes(x) +
stat_function(fun = relu, colour = "blue", size = 1.1) +
labs(x = "", y = "") +
theme_minimal(), tooltip = "") %>%
config(displayModeBar = FALSE)
Função relu
sigmoid <- function(x) 1/(1 + exp(-x))
ggplotly(tibble(x = seq(-6, 6, .1)) %>%
ggplot() +
aes(x) +
stat_function(fun = sigmoid, colour = "blue", size = 1.1) +
labs(x = "", y = "") +
theme_minimal(), tooltip = "") %>%
config(displayModeBar = FALSE)
Função sigmoid
Pelo fato do output da rede ser uma probabilidade (uma camada simples com função de ativação sigmoid) a função de custo indicada é a entropia cruzada. A entropia cruzada é utilizada como forma de estimar o erro entre a distribuição verdadeira e a prevista, e assim atualizar os pesos das camadas ocultas via backpropagation.
A entropia cruzada é determinada por:
\[-\sum_{c=1}^M y_{o, c}\log(p_{o, c})\]
Outras funções de custo poderão ser vistas aqui.
Leitura da base completa:
# leitura da base completa
imdb <- dataset_imdb(num_words = 10000)
Construção da base de treino e teste. Foram selecionados 15000 tanto do treino quanto do teste.
# treino e teste
# treino
set.seed(5)
train_labels <-
tibble(y = imdb$train$y, id = 1:25000) %>%
group_by(y) %>%
sample_n(size = 7500) %>%
ungroup()
train_data <-
train_labels %>%
pull(id) %>%
purrr::map(~ imdb$train$x[[.x]])
# teste
set.seed(7)
test_labels <-
tibble(y = imdb$test$y, id = 1:25000) %>%
group_by(y) %>%
sample_n(size = 7500) %>%
ungroup()
test_data <-
test_labels %>%
pull(id) %>%
purrr::map(~ imdb$test$x[[.x]])
Para decodificar um review segue o código e o exemplo abaixo.
Seja o review codificado como:
str(train_data[[1]])
## int [1:138] 1 14 9 31 7 148 102 198 269 8 ...
A decodificação fica:
# decodificar um review
word_index <- dataset_imdb_word_index()
reverse_word_index <- names(word_index)
names(reverse_word_index) <- word_index
decoded_review <- sapply(train_data[[1]], function(index) {
word <- if (index >= 3) reverse_word_index[[as.character(index - 3)]]
if (!is.null(word)) word else "?"
})
cat(decoded_review)
## ? this is one of those movies that's trying to be moody and tense and instead ends up ? all over itself having seen it at a ? film festival i was intrigued by the young college ? gone wrong write up however over all ended up quite disappointed br br it's hard to critique a true story since there's not much that can be done about the plot but i found this disjointed melodramatic and wholly depressing it's dark and almost sinister painting a darn creepy flash of the seventies with ? music and jerky close ups it just doesn't work some scenes where so cheesy that instead of ? awe my audience was ? ? and rolling eyes br br the story has an interesting premise but this just ? ? into a dark miserable spiral
Como mencionado no início somente as 10000 palavras mais frequentes foram consideradas para análise, então quando descodifica, as palavras que não estão entre as principais recebe um “?”.
Esta etapa apresenta como os dados devem ser ajustados para poderem ser analisados pela rede.
Função para Tranformando os reviews (inputs) em um vetor de 0s e 1s
vectorize_sequences <- function(sequences, dimension = 10000) {
# Creates an all-zero matrix of shape (length(sequences), dimension)
results <- matrix(0, nrow = length(sequences), ncol = dimension)
for (i in 1:length(sequences))
# Sets specific indices of results[i] to 1s
results[i, sequences[[i]]] <- 1
results
}
Adequação dos dados para serem utilizados na rede (tanto do input, quanto do output).
# tranformando os reviews (inputs) em um vetor de 0s e 1s
x_train <- vectorize_sequences(train_data)
x_test <- vectorize_sequences(test_data)
# transformando os outpus em numérico
y_train <- as.numeric(train_labels %>% pull(y))
y_test <- as.numeric(test_labels %>% pull(y))
A rede tem 10000 neurônios no input, as funções de ativação relu nas duas camadas escondidas com seus 10 neurônios e uma sigmoid na única camada no output.
model <- keras_model_sequential() %>%
layer_dense(units = 10, activation = "relu", input_shape = c(10000)) %>%
layer_dense(units = 10, activation = "relu") %>%
layer_dense(units = 1, activation = "sigmoid")
Para o treinamento foi utilizada a função de custo de entropia cruzada e como métrica a acurácia.
model %>% compile(
optimizer = "rmsprop",
loss = "binary_crossentropy",
metrics = c("accuracy")
)
model %>% fit(x_train, y_train, epochs = 4, batch_size = 512)
results <- model %>% evaluate(x_test, y_test)
Para salvar o modelo e utilizá-lo em algum deploy por exemplo.
model %>% export_savedmodel("savedmodel")
A acurácia foi de 0.8832.
Então dado o modelo que foi ajustado, vamos predizer se um review é positivo ou negativo.
The film is: best, great, beautiful and wonderful!
Segue a implementação da função para codificação.
# codificação
coded_review <- function(review){
words <-
review %>%
tolower() %>%
strsplit(split = " ") %>% .[[1]] %>%
gsub("[!,:]", "", x = .)
index <- names(reverse_word_index[reverse_word_index %in% words]) # ver como preservar a ordem
return(list(as.numeric(index) + 3))
}
E o resultado da codificação do exemplo é:
(exemplo1 <-
"The film is: best, great, beautiful and wonderful!" %>%
coded_review()) %>% str
## List of 1
## $ : num [1:8] 118 307 9 87 4 5 389 22
O segundo exemplo:
The film is: the worst, bad, defeat and boring!
(exemplo2 <-
"The film is: the worst, bad, defeat and boring!" %>%
coded_review()) %>% str
## List of 1
## $ : num [1:8] 9 357 4108 78 4 ...
Abaixo a transformação dos reviews codificados no vetor input de dimensão 10000.
# transformando em um vetor de input
(exemplo_vector1 <- vectorize_sequences(exemplo1)) %>% str
## num [1, 1:10000] 0 0 0 1 1 0 0 0 1 0 ...
(exemplo_vector2 <- vectorize_sequences(exemplo2)) %>% str
## num [1, 1:10000] 0 0 0 1 1 0 0 0 1 0 ...
A seguir a predição em termos de probabilidade de cada exemplo.
exemplo_vector1 %>%
predict_savedmodel("savedmodel")
## $dense_3
## [1] 0.696815
exemplo_vector2 %>%
predict_savedmodel("savedmodel")
## $dense_3
## [1] 0.3107629